Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue30/expreval/EXPREVAL.ZIP/testform.pas

Pascal/Delphi Source File | 1998-01-02 | 5.9 KB | 227 lines

unit testform;
interface
{this unit implements the examples used to illustrate the
use of the 'Expressions' unit. These examples are documented
in Expressions.Pas. Please go refer to the main comment block
(just before implementation) in that unit}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Expressions, ExtCtrls;

type
  TForm1 = class(TForm)
    ICount: TLabel;
    Label2: TLabel;
    EG1Button: TButton;
    EG2Button: TButton;
    EG3Button: TButton;
    EG3Result: TLabel;
    EG3Timer: TTimer;
    EG4Button: TButton;
    procedure EG1ButtonClick(Sender: TObject);
    procedure EG2ButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure EG3TimerTimer(Sender: TObject);
    procedure EG3ButtonClick(Sender: TObject);
    procedure EG4ButtonClick(Sender: TObject);
  private
  public
    EG3Expr: TExpression;
    procedure CheckInstances;
    function EG2IDFunc( const Identifier: String;
                           ParameterList: TParameterList): TExpression;
    function EG3IDFunc( const Identifier: String;
                           ParameterList: TParameterList): TExpression;
    function EG4IDFunc( const Identifier: String;
                           ParameterList: TParameterList): TExpression;
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.CheckInstances;
begin
  Icount.Caption:= IntToStr(InstanceCOunt)
end;

procedure TForm1.EG1ButtonClick(Sender: TObject);
var
  s: String;
  E: TExpression;
begin
  s:= '';
  if InputQuery('Example 1', 'Enter an expression...', s) then
  begin
    E:= CreateExpression(s, nil);
    if Assigned(E) then
    try
      MessageDlg(
        Format('E.AsString = %s E.ExprType = %s',
               [E.AsString, NExprType[E.ExprType]]),
        mtInformation, [mbOK], 0)
    finally
      E.Free;
      CheckInstances
    end
  end
end;

function TForm1.EG2IDFunc( const Identifier: String;
                              ParameterList: TParameterList): TExpression;
{this identifier function is used for example 2. It supports the
identifiers SC, FC, IC, and BC}
begin
  {these identifiers do not require parameters, so raise an exception if they exist.
   Note that if a parameter list is passed (due to bad syntax) and then we return a
   valid result, the parameter list will be orphaned and there will be a memory leak}
  if Assigned(ParameterList) then
    raise EExpression.CreateFmt('Identifier %s does not require parameters', [Identifier]);
  if Identifier = 'SC' then
    Result:= TStringLiteral.Create('This is a string')
  else
  if Identifier = 'FC' then
    Result:= TFloatLiteral.Create(8.9)
  else
  if Identifier = 'IC' then
    Result:= TIntegerLiteral.Create(42)
  else
  if Identifier = 'BC' then
    Result:= TBooleanLiteral.Create(False)
  else
    Result:= nil
end;

procedure TForm1.EG2ButtonClick(Sender: TObject);
var
  s: String;
  E: TExpression;
begin
  s:= '';
  if InputQuery('Example 2', 'Expression may contain' +
     ' SC, FC, IC or BC', s) then
  begin
    E:= CreateExpression(s, EG2IDFunc);
    if Assigned(E) then
    try
      MessageDlg(
        Format('E.AsString = %s E.ExprType = %s',
               [E.AsString, NExprType[E.ExprType]]),
        mtInformation, [mbOK], 0)
    finally
      E.Free;
      CheckInstances
    end
  end
end;

type
  TTimeString =
  class(TExpression)
  protected
    function GetAsString: String; override;
    function GetExprType: TExprType; override;
  end;

function TTimeString.GetAsString: String;
begin
  Result:= FormatDateTime('hh:mm:ss', SysUtils.Time)
end;

function TTimeString.GetExprType: TExprType;
begin
  Result:= ttString
end;

function TForm1.EG3IDFunc( const Identifier: String;
                              ParameterList: TParameterList): TExpression;
{this identifier function is used for example 3. It supports the
identifier TimeString}
begin
  if Assigned(ParameterList) then
    raise EExpression.CreateFmt('Identifier %s does not require parameters', [Identifier]);
  if Identifier = 'TIMESTRING' then
    Result:= TTimeString.Create
  else
    Result:= nil
end;

procedure TForm1.EG3TimerTimer(Sender: TObject);
begin
  if Assigned(EG3Expr) then
    EG3Result.Caption:= EG3Expr.AsString
  else
    EG3Result.Caption:= 'EG3 not running'
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  EG3Expr.Free
end;

procedure TForm1.EG3ButtonClick(Sender: TObject);
var
  s: String;
begin
  s:= 'TimeString';
  if InputQuery('Example 3', 'Expression may contain' +
     ' TimeString', s) then
  begin
    EG3Expr.Free;
    EG3Expr:= CreateExpression(s, EG3IDFunc);
    EG3Result.Caption:= EG3Expr.AsString;
    CheckInstances
  end
end;

function TForm1.EG4IDFunc( const Identifier: String;
                              ParameterList: TParameterList): TExpression;
{this identifier function is used for example 4. It supports the
function Mean(a, b: Float): Float; }
begin
  if Identifier = 'MEAN' then
  begin
    if Assigned(ParameterList) and
       (ParameterList.Count = 2) then
    begin
      with ParameterList do
        Result:= TFloatLiteral.Create((AsFloat[0] + AsFloat[1])/2);
      ParameterList.Free
    end else
    begin
      raise EExpression.CreateFmt('Invalid Parameters to %s', [Identifier]);
    end;
  end else
  begin
    Result:= nil
  end
end;


procedure TForm1.EG4ButtonClick(Sender: TObject);
var
  s: String;
  E: TExpression;
begin
  s:= '';
  if InputQuery('Example 4', 'Expression may contain ' +
     'Mean(a, b: Float)', s) then
  begin
    E:= CreateExpression(s, EG4IDFunc);
    if Assigned(E) then
    try
      MessageDlg(
        Format('E.AsString = %s E.ExprType = %s',
               [E.AsString, NExprType[E.ExprType]]),
        mtInformation, [mbOK], 0)
    finally
      E.Free;
      CheckInstances
    end
  end
end;

end.